home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / TEMPJUNK / CIRCK.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-26  |  1KB  |  71 lines
  1. program circk;
  2. uses
  3.      crt,graph;
  4. const
  5.      skip=1;
  6.      tunnelwidth=100;
  7.      tunnelspan=100;
  8. type
  9.      fpointtype=file of pointtype;
  10.  
  11. procedure setupgraph(Gd,Gm:integer);
  12. begin
  13.      InitGraph(Gd,Gm,'c:\tp\bgi');
  14.      if GraphResult<>grOk then halt;
  15.      cleardevice;
  16. end;
  17.  
  18. procedure tunnel(var batchfile:fpointtype);
  19. var
  20.      a:integer;
  21.      temp:pointtype;
  22. begin
  23.      setcolor(white);
  24.      for a:=0 to 359 do
  25.      begin
  26.           seek(batchfile,a);
  27.           read(batchfile,temp);
  28.           with temp do
  29.           circle(x,y,tunnelwidth);
  30.      end;
  31. end;
  32.  
  33. procedure circdef(var batchfile:fpointtype);
  34. var
  35.      a:integer;
  36.      temp:pointtype;
  37.      arccoords:arccoordstype;
  38. begin
  39.      setcolor(black);
  40.      for a:=0 to 359 do
  41.      begin
  42.           arc(getmaxx div 2,getmaxy div 2,a,a+1,tunnelspan);
  43.           getarccoords(arccoords);
  44.           temp.x:=arccoords.xstart;
  45.           temp.y:=arccoords.ystart;
  46.           seek(batchfile,a);
  47.           write(batchfile,temp);
  48.           a:=a+skip-1;
  49.      end;
  50.      cleardevice;
  51. end;
  52.  
  53. procedure control;
  54. var
  55.      batchfile:fpointtype;
  56. begin
  57.      assign(batchfile,'tempfile.dat');
  58. {     rewrite(batchfile);}
  59.      reset(batchfile);
  60.  
  61. {     circdef(batchfile);}
  62.      tunnel(batchfile);
  63.  
  64.      close(batchfile);
  65. {     erase(batchfile);}
  66. end;
  67.  
  68. begin
  69.      setupgraph(vga,vgahi);
  70.      control;
  71. end.